
{***********************************************************}
{                                                           }
{      Informix Data Access Components                      }
{                                                           }
{      TIfxStoredProc component                             }
{                                                           }
{      Copyright (c) 2001-2008 Luxena Software Company      }
{      http://www.luxena.com                                }
{      e-mail: support@luxena.com                           }
{                                                           }
{***********************************************************}

unit IfxStoredProc;

{$I lx.inc}

interface

uses
  Classes, DB, LXDataSetImpl, IfxTypes, IfxSQL, IfxCustomDataSet;


const

{ Property Default Values }

  IFX_DEFAULT_PARAM_CHECK = False;


type

{ TIfxStoredProc }

  TIfxStoredProc = class(TIfxDesignDataSet)
  private
    FProcName: string;
    FTableName: string;
    FParamCheck: Boolean;
    FParams: TParams;

    procedure SetProcName(const Value: string);
    procedure SetParams(Value: TParams);
    function GetParamsCount: Word;
    
    procedure ReadParamData(Reader: TReader);
    procedure WriteParamData(Writer: TWriter);
    
    procedure CheckParams;
    procedure CheckProcSQL;

  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure InternalInitFieldDefs; override;
    procedure SetMasterParams; override;

    { IProviderSupport }
    procedure PSExecute; override;
    function PSGetTableName: string; override;
    function PSGetParams: TParams; override;
    procedure PSSetCommandText(const CommandText: string); override;
    procedure PSSetParams(AParams: TParams); override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    
    procedure GetDetailLinkFields(MasterFields, DetailFields: TList); override;

    procedure CopyParams(Value: TParams);
    function ParamByName(const Value: string): TParam;

    procedure Prepare;
    procedure Unprepare;
    function ExecProc: int4;

    property Prepared;
    property ParamCount: Word read GetParamsCount;
    property RowsAffected;
    property Results;

  published
    property DataSource read GetDataSource write SetDataSource;
    property StoredProcName: string read FProcName write SetProcName;
    property TableName: string read FTableName write FTableName;
    property Params: TParams read FParams write SetParams stored False;
    property ParamCheck: Boolean read FParamCheck write FParamCheck default IFX_DEFAULT_PARAM_CHECK;
    property UpdateObject write SetUpdateObject;
  end;


implementation

uses SysUtils, IfxConsts, Ifx;

const
  SELECT_PROC_ARGS =
    'select numargs from informix.sysprocedures where procname = :procname';


{ TIfxStoredProc }

constructor TIfxStoredProc.Create(AOwner: TComponent);
begin
  inherited;
  FParams := TParams.Create(Self);
  FParamCheck := IFX_DEFAULT_PARAM_CHECK;
  IfxSQL.ParamCheck := False;
  IfxSQL.SourceParams := FParams;
  IfxSQL.IgnoreDataEvent := True;
end;

destructor TIfxStoredProc.Destroy;
begin
  FParams.Free;
  inherited;
end;

procedure TIfxStoredProc.SetProcName(const Value: string);
begin
  if csReading in ComponentState then
    FProcName := Value
  else if FProcName <> Value then
  begin
    CheckInactive;
    FProcName := Value;
    IfxSQL.SQL.Clear;
    CheckParams;
    DataEvent(dePropertyChange, 0);
  end;
end;

procedure TIfxStoredProc.SetParams(Value: TParams);
begin
  FParams.AssignValues(Value);
end;

function TIfxStoredProc.GetParamsCount: Word;
begin
  Result := FParams.Count;
end;

procedure TIfxStoredProc.ReadParamData(Reader: TReader);
begin
  Reader.ReadValue;
  Reader.ReadCollection(FParams);
end;

procedure TIfxStoredProc.WriteParamData(Writer: TWriter);
begin
  Writer.WriteCollection(FParams);
end;

procedure TIfxStoredProc.CheckParams;
var
  IfxSQL: TIfxSQL;
  I: Integer;
begin
  if FParamCheck or (csDesigning in ComponentState) then
    if FProcName = '' then
      FParams.Clear else
    begin
      IfxSQL := CreateInternalSQL(SELECT_PROC_ARGS);
      try
        IfxSQL.Params[0].AsChar := FProcName;
        IfxSQL.Open;
        for I := FParams.Count to IfxSQL.Fields[0].AsInteger - 1 do
          FParams.CreateParam(ftUnknown, IntToStr(I + 1), ptInput);
        for I := FParams.Count - 1 downto IfxSQL.Fields[0].AsInteger do
          FParams.Delete(I);
      finally
        IfxSQL.Free;
      end;
    end;
end;

procedure TIfxStoredProc.CheckProcSQL;
var
  I: Integer;
  ParamsStr: string;
begin
  if IfxSQL.SQL.Count <> 0 then Exit;

  if Trim(FProcName) = '' then
    IDACError(SNoProcName, Self);

  for I := 0 to FParams.Count - 1 do
    if I <> 0 then
      ParamsStr := ParamsStr + ', ?' else
      ParamsStr := '?';

  IfxSQL.SQL.Text := Format('execute procedure %s(%s)', [FProcName, ParamsStr]);
end;

procedure TIfxStoredProc.DefineProperties(Filer: TFiler);

  function WriteData: Boolean;
  begin
    if Filer.Ancestor <> nil then
      Result := not FParams.IsEqual(TIfxStoredProc(Filer.Ancestor).FParams) else
      Result := FParams.Count > 0;
  end;

begin
  inherited;
  Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData);
end;

procedure TIfxStoredProc.InternalInitFieldDefs;
begin
  CheckProcSQL;
  inherited;
end;

procedure TIfxStoredProc.SetMasterParams;
var
  I: Integer;
begin
  for I := 0 to FParams.Count - 1 do
    with FParams[I] do
      if not Bound then
      begin
        AssignField(DataSource.DataSet.FieldByName(Name));
        Bound := False;
      end;
end;

{ TIfxStoredProc.IProviderSupport }

procedure TIfxStoredProc.PSExecute;
begin
  ExecProc;
end;

function TIfxStoredProc.PSGetParams: TParams;
begin
  Result := FParams;
end;

function TIfxStoredProc.PSGetTableName: string;
begin
  Result := FTableName;
end;

procedure TIfxStoredProc.PSSetCommandText(const CommandText: string);
begin
  if CommandText <> '' then
    StoredProcName := CommandText;
end;

procedure TIfxStoredProc.PSSetParams(AParams: TParams);
begin
  if AParams.Count > 0 then
    FParams.Assign(AParams);
  Close;
end;

procedure TIfxStoredProc.GetDetailLinkFields(MasterFields, DetailFields: TList);

  function AddFieldToList(const FieldName: string; DataSet: TDataSet; List: TList): Boolean;
  var
    Field: TField;
  begin
    Field := DataSet.FindField(FieldName);
    if (Field <> nil) then
      List.Add(Field);
    Result := Field <> nil;
  end;

var
  I: Integer;
begin
  MasterFields.Clear;
  DetailFields.Clear;
  if (DataSource <> nil) and (DataSource.DataSet <> nil) then
    for I := 0 to FParams.Count - 1 do
      if AddFieldToList(FParams[I].Name, DataSource.DataSet, MasterFields) then
        AddFieldToList(FParams[I].Name, Self, DetailFields);
end;

procedure TIfxStoredProc.CopyParams(Value: TParams);
begin
  Value.Assign(FParams);
end;

function TIfxStoredProc.ParamByName(const Value: string): TParam;
begin
  Result := FParams.ParamByName(Value);
end;

procedure TIfxStoredProc.Prepare;
begin
  Prepared := True;
end;

procedure TIfxStoredProc.Unprepare;
begin
  Prepared := False;
end;

function TIfxStoredProc.ExecProc: int4;
begin
  CheckInactive;
  CheckProcSQL;
  if DataLink.Active then
    SetMasterParams;
  Result := IfxSQL.Execute;
end;


end.